searchPathContents,
) where
-import System.FilePath.ByteString
-#ifdef WITH_OSPATH
-import qualified System.OsPath as P
-#else
-import qualified System.FilePath.ByteString as P
-#endif
import qualified Data.ByteString as B
+import qualified System.FilePath.ByteString as PB
import Data.List
import Data.Maybe
import Control.Monad
- and removing the trailing path separator.
-
- On Windows, preserves whichever style of path separator might be used in
- - the input RawFilePaths. This is done because some programs in Windows
+ - the input paths. This is done because some programs in Windows
- demand a particular path separator -- and which one actually varies!
-
- This does not guarantee that two paths that refer to the same location,
- and are both relative to the same location (or both absolute) will
- - yield the same result. Run both through normalise from System.RawFilePath
+ - yield the same result. Run both through normalise from System.OsPath
- to ensure that.
-}
-simplifyPath :: RawFilePath -> RawFilePath
+simplifyPath :: OsPath -> OsPath
simplifyPath path = dropTrailingPathSeparator $
joinDrive drive $ joinPath $ norm [] $ splitPath path'
where
p' = dropTrailingPathSeparator p
{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
-parentDir :: RawFilePath -> RawFilePath
+parentDir :: OsPath -> OsPath
parentDir = takeDirectory . dropTrailingPathSeparator
{- Just the parent directory of a path, or Nothing if the path has no
- parent (ie for "/" or "." or "foo") -}
-upFrom :: RawFilePath -> Maybe RawFilePath
+upFrom :: OsPath -> Maybe OsPath
upFrom dir
| length dirs < 2 = Nothing
- | otherwise = Just $ joinDrive drive $
+ | otherwise = Just $ joinDrive drive $ toOsPath $
B.intercalate (B.singleton pathSeparator) $ init dirs
where
-- on Unix, the drive will be "/" when the dir is absolute,
-- otherwise ""
(drive, path) = splitDrive dir
- dirs = filter (not . B.null) $ B.splitWith isPathSeparator path
+ dirs = filter (not . B.null) $ B.splitWith PB.isPathSeparator $ fromOsPath path
-{- Checks if the first RawFilePath is, or could be said to contain the second.
+{- Checks if the first path is, or could be said to contain the second.
- For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
- are all equivalent.
-}
-dirContains :: RawFilePath -> RawFilePath -> Bool
+dirContains :: OsPath -> OsPath -> Bool
dirContains a b = a == b
|| a' == b'
|| (a'' `B.isPrefixOf` b' && avoiddotdotb)
- a'' is a prefix of b', so all that needs to be done is drop
- that prefix, and check if the next path component is ".."
-}
- avoiddotdotb = nodotdot $ B.drop (B.length a'') b'
+ avoiddotdotb = nodotdot $ B.drop (B.length a'') $ fromOsPath b'
nodotdot p = all (not . isdotdot) (splitPath p)
- we stop preserving ordering at that point. Presumably a user passing
- that many paths in doesn't care too much about order of the later ones.
-}
-segmentPaths :: (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[a]]
+segmentPaths :: (a -> OsPath) -> [OsPath] -> [a] -> [[a]]
segmentPaths = segmentPaths' (\_ r -> r)
-segmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> [RawFilePath] -> [a] -> [[r]]
+segmentPaths' :: (Maybe OsPath -> a -> r) -> (a -> OsPath) -> [OsPath] -> [a] -> [[r]]
segmentPaths' f _ [] new = [map (f Nothing) new]
segmentPaths' f _ [i] new = [map (f (Just i)) new] -- optimisation
segmentPaths' f c (i:is) new =
- than it would be to run the action separately with each path. In
- the case of git file list commands, that assumption tends to hold.
-}
-runSegmentPaths :: (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[a]]
+runSegmentPaths :: (a -> OsPath) -> ([OsPath] -> IO [a]) -> [OsPath] -> IO [[a]]
runSegmentPaths c a paths = segmentPaths c paths <$> a paths
-runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]]
+runSegmentPaths' :: (Maybe OsPath -> a -> r) -> (a -> OsPath) -> ([OsPath] -> IO [a]) -> [OsPath] -> IO [[r]]
runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths
{- Checks if a filename is a unix dotfile. All files inside dotdirs
- count as dotfiles. -}
-dotfile :: RawFilePath -> Bool
+dotfile :: OsPath -> Bool
dotfile file
| f == "." = False
| f == ".." = False
where
f = takeFileName file
-{- Similar to splitExtensions, but knows that some things in RawFilePaths
+{- Similar to splitExtensions, but knows that some things in paths
- after a dot are too long to be extensions. -}
-splitShortExtensions :: RawFilePath -> (RawFilePath, [B.ByteString])
+splitShortExtensions :: OsPath -> (OsPath, [B.ByteString])
splitShortExtensions = splitShortExtensions' 5 -- enough for ".jpeg"
-splitShortExtensions' :: Int -> RawFilePath -> (RawFilePath, [B.ByteString])
+splitShortExtensions' :: Int -> OsPath -> (OsPath, [B.ByteString])
splitShortExtensions' maxextension = go []
where
go c f
- a relative path is not possible and the path is simply
- returned as-is.
-}
-relPathDirToFileAbs :: RawFilePath -> RawFilePath -> RawFilePath
+relPathDirToFileAbs :: OsPath -> OsPath -> OsPath
relPathDirToFileAbs from to
#ifdef mingw32_HOST_OS
| normdrive from /= normdrive to = to
-- path separator, which takeDrive leaves on the drive
-- letter.
. dropWhileEnd (isPathSeparator . fromIntegral . ord)
- . fromRawFilePath
+ . fromOsPath
. takeDrive
#endif
-}
searchPath :: String -> IO (Maybe OsPath)
searchPath command
- | P.isAbsolute command' = copyright $ check command'
+ | isAbsolute command' = copyright $ check command'
| otherwise = getSearchPath >>= getM indir . map toOsPath
where
command' = toOsPath command
- indir d = check (d P.</> command')
+ indir d = check (d </> command')
check f = firstM doesFileExist
#ifdef mingw32_HOST_OS
[f, f <> ".exe"]
filterM doesFileExist
=<< (concat <$> (getSearchPath >>= mapM (go . toOsPath)))
where
- go d = map (d P.</>) . filter p
+ go d = map (d </>) . filter p
<$> catchDefaultIO [] (getDirectoryContents d)
{- Temporary directories
-
- - Copyright 2010-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2025 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
) where
import Control.Monad.IfElse
-import System.FilePath
-import System.Directory
import Control.Monad.IO.Class
#ifndef mingw32_HOST_OS
import System.Posix.Temp (mkdtemp)
import Utility.Exception
import Utility.Tmp (Template)
import Utility.OsPath
-import Utility.FileSystemEncoding
+import Utility.SystemDirectory
{- Runs an action with a tmp directory located within the system's tmp
- directory (or within "." if there is none), then removes the tmp
- directory and all its contents. -}
-withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a
+withTmpDir :: (MonadMask m, MonadIO m) => Template -> (OsPath -> m a) -> m a
withTmpDir template a = do
- topleveltmpdir <- liftIO $ catchDefaultIO "." getTemporaryDirectory
+ topleveltmpdir <- liftIO $
+ catchDefaultIO (literalOsPath ".") getTemporaryDirectory
+ let p = fromOsPath $ topleveltmpdir </> template
#ifndef mingw32_HOST_OS
-- Use mkdtemp to create a temp directory securely in /tmp.
bracket
- (liftIO $ mkdtemp $ topleveltmpdir </> fromRawFilePath (fromOsPath template))
+ (liftIO $ toOsPath <$> mkdtemp p)
removeTmpDir
a
#else
{- Runs an action with a tmp directory located within a specified directory,
- then removes the tmp directory and all its contents. -}
-withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a
+withTmpDirIn :: (MonadMask m, MonadIO m) => OsPath -> Template -> (OsPath -> m a) -> m a
withTmpDirIn tmpdir template = bracketIO create removeTmpDir
where
create = do
createDirectoryIfMissing True tmpdir
- makenewdir (tmpdir </> fromRawFilePath (fromOsPath template)) (0 :: Int)
+ makenewdir (tmpdir </> template) (0 :: Int)
makenewdir t n = do
- let dir = t ++ "." ++ show n
+ let dir = t <> toOsPath ("." ++ show n)
catchIOErrorType AlreadyExists (const $ makenewdir t $ n + 1) $ do
createDirectory dir
return dir
{- Deletes the entire contents of the the temporary directory, if it
- exists. -}
-removeTmpDir :: MonadIO m => FilePath -> m ()
+removeTmpDir :: MonadIO m => OsPath -> m ()
removeTmpDir tmpdir = liftIO $ whenM (doesDirectoryExist tmpdir) $ do
#if mingw32_HOST_OS
-- Windows will often refuse to delete a file
projects / git-annex.git / commitdiff